home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.07.lha / AmiCAD / ARexx / R馭駻encer.AmiCAD < prev    next >
Text File  |  2000-11-11  |  7KB  |  212 lines
  1. /* Ajout des références aux composants du type sélectionné ou spécifié
  2.    © R.Florac, Chez Corbin, 2 juin 1998, v1.00
  3.    Version 1.02, 1er juillet 1998: ajout TEST_CIRCUIT pour marquer tous les composants (oubli)
  4.    Version 1.03, 16 mars 1999: modification fonction ASKTEXT
  5.    Version 1.04, 13 avril 2000: adaptation version 2.05
  6.    Version 1.05, 16 avril 2000: ajout init ROTATE, SYMMETRY, SETSCALE.
  7.                 Amélioration placement références nouvelles.
  8.    Version 1.06, 11 novembre 2000: localisation anglais/français
  9.    $VER: Référencer.AmiCAD 1.06 (© R.Florac, 11/11/2000) */
  10.  
  11. options results     /* indispensable pour récupérer le résultat des macros */
  12.  
  13. signal on error     /* pour l'interception des erreurs */
  14. signal on syntax
  15.  
  16. 'LANGUAGE'
  17. if result="français.language" then fr=1
  18. else fr=0
  19.  
  20. if fr=1 then 'SELECT("Type de composant à référencer"+CHR(10)+"Résistances"+CHR(10)+"Condensateurs"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Circuits intégrés"+CHR(10)+"Tous les composants"+CHR(10)+"Composants spécifiés")'
  21. else 'SELECT("Component type to reference"+CHR(10)+"Resistances"+CHR(10)+"Capacitors"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Integrated circuits"+CHR(10)+"All the components"+CHR(10)+"Specified components")'
  22. choix=result
  23. select
  24.     when choix=1 then do
  25.     reference='R'
  26.     type="Rés#?"
  27.     end
  28.     when choix=2 then do
  29.     reference='C'
  30.     type="Cond#?"
  31.     end
  32.     when choix=3 then do
  33.     reference='D'
  34.     type="Diod#?"
  35.     end
  36.     when choix=4 then do
  37.     reference='Q'
  38.     type="Transist#?"
  39.     end
  40.     when choix=5 then do
  41.     reference="CI"
  42.     type=1
  43.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
  44.     end
  45.     when choix=6 then do
  46.     'SAVEALL'
  47.     call marquer_composant('R',"Rés#?",-1)
  48.     call marquer_composant('C',"Cond#?",-1)
  49.     call marquer_composant('D',"Diod#?",-1)
  50.     call marquer_composant('Q',"Transist#?",-1)
  51.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'       /*  v1.02 */
  52.     call marquer_composant('CI',1,-1)
  53.     exit
  54.     end
  55.     when choix=7 then do
  56.     if fr=1 then 'ASKTEXT("Quel est le nom des"+CHR(10)+"composants à référencer?"+CHR(10)+"Vous pouvez utiliser"+CHR(10)+"les jokers(#?) pour"+CHR(10)+"étendre la sélection","")'
  57.     else 'ASKTEXT("What is the name of the"+CHR(10)+"components to reference?"+CHR(10)+"You can use jokers(#?) to"+CHR(10)+"extend the selection","")'
  58.     type=result
  59.     if type='' then exit
  60.     if fr=1 then 'ASKTEXT("Quelle est la référence"+CHR(10)+"à donner à ces composants?","")'
  61.     else 'ASKTEXT("What is the reference"+CHR(10)+"to give to these components?","")'
  62.     reference=result
  63.     if reference='' then exit
  64.     end
  65.     otherwise exit
  66. end
  67. 'N=FIRSTSEL'; obj=result
  68. if obj>0 then do
  69.     if fr=1 then 'REQUEST("Voulez-vous marquer"+CHR(10)+"uniquement les"+CHR(10)+"objets sélectionnés?")'
  70.     else 'REQUEST("Do-you want to reference"+CHR(10)+"only the"+CHR(10)+"selected objects?")'
  71.     choix=result
  72. end
  73. else choix=0
  74. 'SAVEALL'
  75. call marquer_composant(reference,type,choix)
  76. exit
  77.  
  78. marquer_composant: procedure
  79.     parse arg reference,type,selection
  80.     if selection<=0 then do
  81.     /* Annulation du marquage éventuel */
  82.     'UNMARK(-1)'
  83.     /* Marquage et comptage des éléments à référencer */
  84.     if type=1 then 'SECURITY(OBJECTS+10):I=0:N=1:WHILE(N<=OBJECTS,IF(TYPE(N)==1,IF(GETDEVS(PARTNAME(N))>0,MARK(N):I=I+1,0),0),N=N+1):I'
  85.     else 'SECURITY(OBJECTS+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS,FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
  86.     n=result
  87.     end
  88.     else do
  89.     /* Comptage des éléments déjà marqués */
  90.     if type=1 then 'SECURITY(OBJECTS+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
  91.     else 'SECURITY(OBJECTS+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
  92.     n=result
  93.     end
  94.     if n=0 then do
  95.     if selection>=0 then do
  96.         if fr=1 then 'MESSAGE("Il n''y a aucun"+CHR(10)+"objet de ce type")'
  97.         else 'MESSAGE("There is no"+CHR(10)+"object of this type")'
  98.         exit
  99.     end
  100.     else return
  101.     end
  102.  
  103.     /* Test des références, ajout éventuel */
  104.     call test_references(type,reference)
  105.     objet=selection_objet(1,type)
  106.     do i=1 to n
  107.     'GETREF('objet')'; ref=result
  108.     if ref=0 then call ajouter_reference(objet,reference)
  109.     else do
  110.         'READTEXT('ref')'
  111.         j=right(result,length(result)-length(reference))
  112.         if j~="" then do
  113.         ref.i=1
  114.         end
  115.     end
  116.     if i<n then objet=selection_objet(objet+1,type)
  117.     end
  118.  
  119.     /* Écriture des références */
  120.     objet=selection_objet(1,type)
  121.     numref=0
  122.     do i=1 to n
  123.     if ref.i~=1 then do
  124.         numref=numref+1
  125.         do while val.numref=1
  126.         numref=numref+1
  127.         end
  128.         'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'"):GETDEVS(PARTNAME('objet'))'
  129.         if result>1 then do
  130.         'SETTEXT(R,READTEXT(R)+CHR(READDEV('objet')+64))'
  131.         end
  132.     end
  133.     if i<n then do
  134.         objet=selection_objet(objet+1,type)
  135.     end
  136.     end
  137.     return
  138. end
  139.  
  140. ajouter_reference: procedure
  141.     parse arg obj,reference
  142.     'GETPOS('obj')'
  143.     p=result
  144.     if p=1 | p=3 then do
  145.     'GETVAL('obj')'; c=result
  146.     if c~=0 then do
  147.         'COL('c')'
  148.         c=result
  149.     end
  150.     else do
  151.         'COL('obj')+WIDTH('obj')+5'; c=result
  152.     end
  153.     'LINE('obj')+HEIGHT('obj')/2'; l=result
  154.     end
  155.     else do
  156.     'COL('obj')+WIDTH('obj')/2-TXWIDTH("'reference'")'; c=result
  157.     'LINE('obj')'; l=result
  158.     end
  159.     'LINKREF('obj',WRITE("'reference'",'c','l'))'
  160.     return
  161. end
  162.  
  163. selection_objet: procedure
  164.     parse arg obj,type
  165.     if type=1 then do
  166.     'R='obj':WHILE(TEST_CIRCUIT(R)<1,R=NEXTSEL(R)):R'
  167.     end
  168.     else do
  169.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  170.     end
  171.     return result
  172. end
  173.  
  174. /* Procédure testant et marquant les références déjà existantes */
  175. test_references: procedure expose val.
  176.     parse arg type,reference
  177.     obj=1
  178.     'ROTATE(0,0):SETSCALE(0,100,100):SYMMETRY(0,0):OBJECTS';objets=result
  179.     do while obj<=objets
  180.     if type=1 then do
  181.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  182.     end
  183.     else do
  184.         'FINDPART('obj',"'type'")'; obj=result
  185.     end
  186.     if obj=0 then leave
  187.     'GETREF('obj')'; ref=result
  188.     if ref>0 then do
  189.         'READTEXT('ref')'
  190.         j=right(result,length(result)-length(reference))
  191.         if j~="" then do
  192.         'VAL("'j'")'; j=result
  193.         val.j=1
  194.         end
  195.     end
  196.     obj=obj+1
  197.     end
  198.     return
  199. end
  200.  
  201. /* Traitement des erreurs, interruption du programme */
  202. syntax:
  203. erreur=RC
  204. if fr=1 then 'MESSAGE("Script Référencer.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  205. else 'MESSAGE("Référencer.AmiCAD script"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  206. exit
  207.  
  208. error:
  209. if fr=1 then 'MESSAGE("Script Référencer.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  210. else 'MESSAGE("Référencer.AmiCAD script"+CHR(10)+"Error in line 'SIGL'")'
  211. exit
  212.